home *** CD-ROM | disk | FTP | other *** search
/ ADA Programming Guide / ADA Programming Guide.iso / ada_pcdp / ada / sem.ada < prev    next >
Encoding:
Text File  |  1996-01-30  |  2.1 KB  |  101 lines
  1. package Semaphore_Package is
  2.  
  3.   type Semaphore is private;
  4.   type Binary_Semaphore is private;
  5.  
  6.   function Init(N: Integer) return Semaphore;
  7.   procedure Wait  (S: Semaphore);
  8.   procedure Signal(S: Semaphore);
  9.  
  10.   function Init(N: Integer) return Binary_Semaphore;
  11.   procedure Wait  (S: Binary_Semaphore);
  12.   procedure Signal(S: Binary_Semaphore);
  13.  
  14.   Bad_Semaphore_Initialization: exception;
  15.  
  16. private
  17.  
  18.   task type Semaphore_Task is
  19.     entry Init(N: Integer; B: Boolean);
  20.     entry Wait;
  21.     entry Signal;
  22.   end Semaphore_Task;
  23.  
  24.   type Semaphore is access Semaphore_Task;
  25.   type Binary_Semaphore is access Semaphore_Task;
  26.  
  27. end Semaphore_Package;
  28.  
  29. package body Semaphore_Package is
  30.  
  31.   task body Semaphore_Task is
  32.     Binary: Boolean;
  33.     V: Integer;
  34.   begin
  35.     accept Init(N: Integer; B: Boolean) do
  36.       Binary := B;
  37.       V := N;
  38.     end Init;
  39.     loop
  40.       select
  41.         accept Wait do
  42.           if V > 0 then V := V - 1;
  43.           else accept Signal;
  44.           end if;
  45.         end Wait;
  46.       or
  47.         accept Signal do
  48.           if not Binary or else V = 0 then
  49.             V := V + 1;
  50.           end if;
  51.         end Signal;
  52.       or
  53.         terminate;
  54.       end select;
  55.     end loop;
  56.   end Semaphore_Task;
  57.  
  58.   function Init(N: Integer) return Semaphore is
  59.     S: Semaphore;
  60.   begin
  61.     if N < 0 then raise Bad_Semaphore_Initialization;
  62.     else
  63.       S := new Semaphore_Task;
  64.       S.Init(N, False);
  65.       return S;
  66.     end if;
  67.   end Init;
  68.  
  69.   function Init(N: Integer) return Binary_Semaphore is
  70.     S: Binary_Semaphore;
  71.   begin
  72.     if (N < 0) or (N > 1) then raise Bad_Semaphore_Initialization;
  73.     else
  74.       S := new Semaphore_Task;
  75.       S.Init(N, True);
  76.       return S;
  77.     end if;
  78.   end Init;
  79.  
  80.   procedure Wait(S: Semaphore) is
  81.   begin
  82.     S.Wait;
  83.   end Wait;
  84.  
  85.   procedure Signal(S: Semaphore) is
  86.   begin
  87.     S.Signal;
  88.   end Signal;
  89.  
  90.   procedure Wait(S: Binary_Semaphore) is
  91.   begin
  92.     S.Wait;
  93.   end Wait;
  94.  
  95.   procedure Signal(S: Binary_Semaphore) is
  96.   begin
  97.     S.Signal;
  98.   end Signal;
  99.  
  100. end Semaphore_Package;
  101.